module dbg; implicit none;
integer, parameter:: R14 = selected_real_kind(14);

real(R14), parameter :: PI=DACOS(-1.D0);

real(R14), parameter :: ERR1 = 1.D-1;
real(R14), parameter :: ERR2 = 1.D-2;
real(R14), parameter :: ERR3 = 1.D-3;
real(R14), parameter :: ERR4 = 1.D-4;
real(R14), parameter :: ERR5 = 1.D-5;
real(R14), parameter :: ERR6 = 1.D-6;
real(R14), parameter :: ERR7 = 1.D-7;
real(R14), parameter :: ERR8 = 1.D-8;
real(R14), parameter :: ERR9 = 1.D-9;
real(R14), parameter :: ERR10 = 1.D-10;
real(R14), parameter :: ERR11 = 1.D-11;
real(R14), parameter :: ERR12 = 1.D-12;
real(R14), parameter :: ERR13 = 1.D-13;
real(R14), parameter :: ERR14 = 1.D-14;
real(R14), parameter :: ERR15 = 1.D-15;
real(R14), parameter :: MAX_ZERO = 1.D-32;

real(R14), parameter :: D0 = 0.D0;
real(R14), parameter :: D1 = 1.D0;
real(R14), parameter :: D2 = 2.D0;
real(R14), parameter :: D3 = 3.D0;
real(R14), parameter :: D4 = 4.D0;
real(R14), parameter :: D5 = 5.D0;
real(R14), parameter :: D6 = 6.D0;
real(R14), parameter :: D7 = 7.D0;
real(R14), parameter :: D8 = 8.D0;
real(R14), parameter :: D9 = 9.D0;
real(R14), parameter :: D10 = 10.D0;

real(R14), parameter :: D01 = 0.1D0;
real(R14), parameter :: D02 = 0.2D0;
real(R14), parameter :: D03 = 0.3D0;
real(R14), parameter :: D04 = 0.4D0;
real(R14), parameter :: D05 = 0.5D0;
real(R14), parameter :: D06 = 0.6D0;
real(R14), parameter :: D07 = 0.7D0;
real(R14), parameter :: D08 = 0.8D0;
real(R14), parameter :: D09 = 0.9D0;


!logical, save :: VEC_DBG_ON ;
integer, save :: VEC_DBG_VIEW_N = 10;

contains;

!--> dbg_xxx
subroutine dbg_vec(info, v, on);  implicit none;  
  character(LEN=*), intent(in) :: info;   
  real(R14), dimension(:), intent(in) :: v; 
  logical, optional, intent(in) :: on;  
  integer :: i, n;
  if (present(on) .AND. (.NOT. on)) return;
  
  if (SIZE(v) <= VEC_DBG_VIEW_N) then
    write(*,*) info, (v(i), i = LBOUND(v, 1), UBOUND(v, 1));
  else
    n = VEC_DBG_VIEW_N / 2;
    write(*,*) info, "(", LBOUND(v, 1), ":", UBOUND(v, 1), ")=", &
    & (v(i), i = LBOUND(v, 1), LBOUND(v, 1) + n - 1), ", ..., ", &
    & (v(i), i = UBOUND(v, 1) - n + 1, UBOUND(v, 1));
  end if
end subroutine

subroutine dbg_info(info, on);  implicit none;  
  character(LEN=*), intent(in) :: info;   
  logical, optional, intent(in) :: on;  
  if (present(on) .AND. (.NOT. on)) return;  
  write(*,*) info;
end subroutine

subroutine dbg_str(info, str, on);  implicit none;  
  character(LEN=*), intent(in) :: info, str;   
  logical, optional, intent(in) :: on;  
  if (present(on) .AND. (.NOT. on)) return;  
  write(*,*) info, "'", str, "'";
end subroutine

subroutine dbg_bool(info, v, on);  implicit none;  
  character(LEN=*), intent(in) :: info;   
  logical, intent(in) :: v; 
  logical, optional, intent(in) :: on;  
  if (present(on) .AND. (.NOT. on)) return;  
  write(*,*) info, v;
end subroutine

subroutine dbg_real(info, v, on);  implicit none;  
  character(LEN=*), intent(in) :: info;   
  real(R14), intent(in) :: v; 
  logical, optional, intent(in) :: on;  
  if (present(on) .AND. (.NOT. on)) return;  
  write(*,*) info, v;
end subroutine

subroutine dbg_int(info, v, on);  implicit none;  
  character(LEN=*), intent(in) :: info;   
  integer, intent(in) :: v; 
  logical, optional, intent(in) :: on;  
  if (present(on) .AND. (.NOT. on)) return;  
  write(*,*) info, v;
end subroutine

!--> test_xxx
logical function test_max_zero(z) result(res); implicit none;
  real(R14), intent(in) :: z;
  res = test_max_err(z, MAX_ZERO);
  return;
end function

logical function test_max_err(z, max_err) result(res); implicit none;
  real(R14), intent(in) :: z, max_err;
  res = (ABS(z) <= max_err);
  return;
end function

logical function test_max_diff(z, z2, max_err, trace_on) result(res); implicit none;
  real(R14), intent(in) :: z, z2, max_err;
  logical, optional, intent(in) :: trace_on;
  call dbg_real("test_max_diff(z=", z, trace_on);
  call dbg_real("____________(z2=", z2, trace_on);
  call dbg_real("_____(ABS(z-z2)=", ABS(z-z2), trace_on);
  call dbg_real("________max_err=", max_err, trace_on);
  res = (ABS(z-z2) <= max_err);
  return;
end function

subroutine assert_max_err(info, z, max_err); implicit none;
  character(LEN=*), intent(in) :: info;
  real(R14), intent(in) :: z, max_err;
  if (test_max_err(z, max_err)) return;
  call dbg_real(info, z);
  call dbg_real("exit assert_max_err=", max_err);
  call exit(1);
return;
end subroutine

subroutine assert_max_diff(info, z, z2, maxerr, trace); implicit none;
  character(LEN=*), intent(in) :: info;
  real(R14), intent(in) :: z, z2, maxerr;
  logical, optional, intent(in) :: trace;
  logical :: ok;
  call dbg_info(info, trace);
  ok = test_max_diff(z, z2, maxerr, trace);
  if (ok) return;
  call dbg_info(info, .TRUE.);
  ok = test_max_diff(z, z2, maxerr, .TRUE.); ! report error
  call exit(1);
return;
end subroutine


subroutine assert_max_diff_vec(info, pv, pv2, maxerr, trace);  implicit none;
  character(len=1024) :: helpi
  character(LEN=*), intent(IN) :: info;
  real(R14), intent(IN) :: pv(:), pv2(:), maxerr;
  logical, optional, intent(in) :: trace;
  integer :: i;
  do i = LBOUND(pv, 1), UBOUND(pv, 1)
    write (helpi, *) info, ", i = ", i;
    call assert_max_diff(TRIM(helpi), pv(i), pv2(i), maxerr, trace);
  end do
return;
end subroutine


subroutine assert_max_zero(info, z); implicit none;
  character(LEN=*), intent(in) :: info;
  real(R14), intent(in) :: z;
  call assert_max_err(info, z, MAX_ZERO);
return;
end subroutine


subroutine assert_true(info, ok); implicit none;
  character(LEN=*), intent(in) :: info;
  logical, intent(in) :: ok;
  if (ok) return;
  call dbg_bool(info, ok);
  call dbg_info("exit assert_true");
  call exit(1);
return;
end subroutine

subroutine assert_help_str(help, str); implicit none;
  character(LEN=*), intent(in) :: help, str;
  if (help == str) return;
  call dbg_str("help=", help);
  call dbg_str("str =", str);
  call dbg_info("exit in assert_help_str");
  call exit(1);
return;
end subroutine


end module 